home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / pbtlte12.zip / DEMO.BAS < prev    next >
BASIC Source File  |  1992-02-29  |  13KB  |  406 lines
  1. $CPU 8086
  2. $LIB ALL OFF
  3. $ERROR ALL OFF
  4.  
  5. DEFINT A-Z
  6.  
  7. 'Declarations for PBTools
  8.  
  9. PUBLIC Xpos%(), Ypos%(), WAttr%(), Xlen%(), Ylen%(), BAttr%(), ScrSav$(),_
  10.        Brdr%(), Shad%(), Pntr%(), CurWin%, MaxWin%
  11.  
  12. MaxWin%=20  'Defaults to 15, reset to 20 for demo.
  13.  
  14. $LINK "PBTLITE.PBU"
  15. $SEGMENT
  16.  
  17. DIM Menu1$(1:9)
  18. Menu1$(1)=" Border Types   "
  19. Menu1$(2)=" Moving Windows "
  20. Menu1$(3)=" Recoloring     "
  21. Menu1$(4)=" resiZing       "
  22. Menu1$(5)=" scroLling      "
  23. Menu1$(6)=" Shadows        "
  24. Menu1$(7)=" Titles         "
  25. Menu1$(8)=" Other Demos    "
  26. Menu1$(9)=" Exit Demo      "
  27.  
  28. DIM Menu2$(1:4)
  29. Menu2$(1)=" Key status     "
  30. Menu2$(2)=" String tools   "
  31. Menu2$(3)=" string Testing "
  32. Menu2$(4)=" Quit to main   "
  33.  
  34. True$="On "
  35. False$="Off"
  36. Yes$="Yes"
  37. No$="No "
  38.  
  39. CALL InitPBScreen
  40.  
  41. CALL Fill(1,1,25,80,178,23)
  42.  
  43. CALL OpenWin(5,12,13,58,11,20,31,3,1,0)  'Window #1
  44. CALL WPrintC(1,"PBTools:Lite v1.2",0)
  45. CALL WPrintC(2,"Copyright (c) 1990 by Dave Navarro, Jr.",0)
  46. CALL WPrintC(3,"Demo by James R. Davis",0)
  47.  
  48. IF CurDisplay%=0 THEN Mon$="Monochrome"
  49. IF CurDisplay%=1 THEN Mon$="CGA"
  50. IF CurDisplay%=2 THEN Mon$="EGA"
  51. IF CurDisplay%=3 THEN Mon$="MCGA"
  52. IF CurDisplay%=4 THEN Mon$="VGA"
  53.  
  54. Text$="A "+Mon$+" monitor is running in display mode"+STR$(VidMode%)
  55. CALL WPrintC(5,Text$,0)
  56.  
  57. Text$="Video RAM segment located at "+HEX$(VidSeg%)+"H "
  58. CALL WPrintC(6,Text$,0)
  59.  
  60. Text$="System has"+STR$(FRE(-1)\1024)+"K Free RAM"
  61. CALL WPrintC(7,Text$,0)
  62.  
  63. Text$="The value of the top of the current cursor is"+STR$(CurTop%)
  64. CALL WPrintC(8,Text$,0)
  65.  
  66. Text$="The value of the bottom of the current cursor is"+STR$(CurBot%)
  67. CALL WPrintC(9,Text$,0)
  68.  
  69. CALL WPrintC(11,"Press Any Key to Continue",0)
  70. I$=GetKey$
  71. CALL CloseWin
  72.  
  73. FirstMenu:
  74. CALL OpenWin(2,20,5,45,2,30,31,3,0,0)       'Window #1
  75. CALL WPrintC(1,"PBTools:Lite v1.2",0)
  76. CALL WPrintC(2,"(C) Copyright 1991 by Dave Navarro, Jr.",0)
  77. CALL WPrintC(3,"Demo by James R. Davis",0)
  78. CALL OpenWin(8,4,11,20,2,30,31,3,1,1)       'Window #2
  79. IF CurDisplay%=0 THEN Menu1$(3)=" =-=-=-=-=-=-=-= "
  80. IF CurDisplay%=0 THEN Hilite%=Attr%(0,7) ELSE Hilite%=Attr%(1,7)
  81. XWin%=1:YWin%=2
  82.  
  83. MainMenu:
  84.   Choice%=Menu%(Menu1$(),1,9,Choice%,Hilite%,Attr%(14,1))
  85.   IF Choice%<1 THEN Choice%=9:GOTO MainMenu
  86.   IF Choice%=1 THEN BorTypes
  87.   IF Choice%=2 THEN MovingWin
  88.   IF Choice%=3 THEN CycleColors
  89.   IF Choice%=4 THEN Resize
  90.   IF Choice%=5 THEN Scrolling
  91.   IF Choice%=6 THEN Shadows
  92.   IF Choice%=7 THEN Titles
  93.   IF Choice%=8 THEN Other
  94.   IF Choice%=9 THEN SayBye
  95.   GOTO MainMenu
  96.  
  97. Titles:
  98.   CALL OpenWin(7,14,15,55,2,30,31,3,1,0)    'Window #3
  99.   CALL WPrintC(6,"You can place titles in 6 different",0)
  100.   CALL WPrintC(8,"positions on the window border.    ",0)
  101.   DELAY 1
  102.   CALL Title(1,0,"[Position 1]")
  103.   DELAY 1
  104.   CALL Title(2,0,"[Position 2]")
  105.   DELAY 1
  106.   CALL Title(3,0,"[Position 3]")
  107.   DELAY 1
  108.   CALL Title(4,0,"[Position 4]")
  109.   DELAY 1
  110.   CALL Title(5,0,"[Position 5]")
  111.   DELAY 1
  112.   CALL Title(6,0,"[Position 6]")
  113.   DELAY 4
  114.   CALL CloseWin
  115.   GOTO MainMenu
  116.  
  117. Shadows:
  118.   CALL OpenWin(6,13,10,30,2,30,31,0,1,0)    'Window #3
  119.   CALL WPrintC(4,"No Shadow!",0)
  120.   DELAY 2
  121.   CALL OpenWin(8,19,10,30,2,30,31,1,1,0)    'Window #4
  122.   CALL WPrintC(3,"Solid Shadow",0)
  123.   CALL WPrintC(5,"Drop Left",0)
  124.   DELAY 3
  125.   CALL OpenWin(10,25,10,30,2,30,31,2,1,0)   'Window #5
  126.   CALL WPrintC(3,"Solid Shadow",0)
  127.   CALL WPrintC(5,"Drop Right",0)
  128.   DELAY 3
  129.   CALL OpenWin(12,31,10,30,2,30,31,3,1,0)   'Window #6
  130.   CALL WPrintC(3,"Transparent Shadow",0)
  131.   CALL WPrintC(5,"Drop Left",0)
  132.   DELAY 3
  133.   CALL OpenWin(14,37,10,30,2,30,31,4,1,0)   'Window #7
  134.   CALL WPrintC(3,"Transparent Shadow",0)
  135.   CALL WPrintC(5,"Drop Right",0)
  136.   DELAY 3
  137.   CALL CloseWin
  138.   DELAY 1
  139.   CALL CloseWin
  140.   DELAY 1
  141.   CALL CloseWin
  142.   DELAY 1
  143.   CALL CloseWin
  144.   DELAY 1
  145.   CALL CloseWin
  146.   GOTO MainMenu
  147.  
  148. Scrolling:
  149.   CALL OpenWin(20,18,4,50,2,30,31,3,0,0)    'Window #3
  150.   CALL WPrintC(1,"Scroll the inside of a window any direction!",0)
  151.   CALL WPrintC(2,"+/- Speed; Press ESC to end scrolling demo.",0)
  152.   CALL OpenWin(8,28,10,50,2,30,31,3,0,0)    'Window #4
  153.   CALL WPrintC(1,"Bouncing!!",0)
  154.   Yscr%=1:XScr%=20:Xdir%=-1:Ydir%=1:D=1:I$=""
  155.   CALL ClrKbd
  156.   DO
  157.      I$=INKEY$
  158.      IF I$="-" THEN INCR D,D/3:IF D>=4 THEN D=4
  159.      IF I$="+" THEN DECR D,D/3:IF D<=.000001 THEN D=.000001
  160.      IF Xdir%<0 THEN DECR XScr% ELSE INCR XScr%
  161.      IF Ydir%<0 THEN DECR YScr% ELSE INCR YScr%
  162.      IF XScr%<1 THEN Xdir%=1:SOUND 200,.2 ELSE IF XScr%>37 THEN Xdir%=-1:SOUND 200,.2
  163.      IF YScr%<3 THEN YDir%=1:SOUND 200,.2 ELSE IF YScr%>8 THEN YDir%=-1:SOUND 200,.2
  164.      IF Xdir%<0 THEN CALL ScrollWin(4) ELSE CALL ScrollWin(3)
  165.      IF Ydir%<0 THEN CALL ScrollWin(2) ELSE CALL ScrollWin(1)
  166.      DELAY D
  167.   LOOP UNTIL I$=CHR$(27)
  168.   CALL CloseWin
  169.   CALL CloseWin
  170.   GOTO MainMenu
  171.  
  172. Resize:
  173.   CALL OpenWin(20,18,4,50,2,30,31,3,0,0)    'Window #3
  174.   CALL WPrintC(1,"Resizing windows is easy!!",0)
  175.   CALL WPrintC(2,"Press ESC to end resizing demo.",0)
  176.   CALL OpenWin(7,35,9,25,2,30,31,0,0,0)     'Window #4
  177.   CALL WPrint(1,2,"Resizing!!!",0)
  178.   Xlen%=25:Ylen%=9:Xdir%=-1:Ydir%=-1
  179.   KeyLoop:
  180.      IF Xdir%<0 THEN DECR Xlen% ELSE INCR Xlen%
  181.      IF YDir%<0 THEN DECR Ylen% ELSE INCR Ylen%
  182.      IF XLen%<15 THEN Xdir%=1 ELSE IF Xlen%>34 THEN Xdir%=-1
  183.      IF Ylen%<3 THEN Ydir%=1 ELSE IF Ylen%>15 THEN Ydir%=-1
  184.      IF Xdir%<0 THEN CALL ChangeWin(2) ELSE CALL ChangeWin(1)
  185.      IF Ydir%<0 THEN CALL ChangeWin(4) ELSE CALL ChangeWin(3)
  186.      IF INKEY$<>CHR$(27) THEN KeyLoop
  187.   CALL CloseWin
  188.   CALL CloseWin
  189.   GOTO MainMenu
  190.  
  191. MovingWin:
  192.   CALL OpenWin(21,17,4,50,2,30,31,0,0,0)    'Window #3
  193.   CALL WPrintC(1,"Use Arrow Keys to move Menu",0)
  194.   CALL WPrintC(2,"Press ESC when your finished. ",0)
  195.   CurWin%=2      'Be Careful when you change the current windo!
  196.   CALL NoShadow
  197.   EndlessLoop:
  198.     I$=GetKey$
  199.     IF I$=CHR$(27) THEN NoMove
  200.     IF I$=CHR$(0,77) AND XWin%<57 THEN INCR XWin%:CALL MoveWin(1)
  201.     IF I$=CHR$(0,75) AND XWin%>1 THEN DECR XWin%:CALL MoveWin(2)
  202.     IF I$=CHR$(0,80) AND YWin%<3 THEN INCR YWin%:CALL MoveWin(3)
  203.     IF I$=CHR$(0,72) AND YWin%>1 THEN DECR YWin%:CALL MoveWin(4)
  204.     GOTO EndlessLoop
  205.   NoMove:
  206.     CurWin%=3
  207.     CALL CloseWin
  208.     CALL AddShadow(3)
  209.     GOTO MainMenu
  210.  
  211. CycleColors:
  212.   IF CurDisplay%=0 THEN MainMenu
  213.   CurWin%=1
  214.     FOR I%=128 TO 1 STEP -1
  215.       CALL WinColor(I%)
  216.       FOR T%=1 TO 32000:NEXT T%
  217.       IF INKEY$<>"" THEN EXIT FOR
  218.     NEXT I%
  219.   CALL WinColor%(31)
  220.   CurWin%=2
  221.   GOTO MainMenu
  222.  
  223. BorTypes:
  224.   CALL OpenWin(7,4,17,76,2,30,31,3,0,0)     'Window #3
  225.   IF CurDisplay%=0 THEN Normal%=Attr%(0,7) ELSE Normal%=Attr%(1,7)
  226.   FOR I%=3 TO 0 STEP -1                     'Window #4-7
  227.     CALL OpenWin(8,14+(I%*15),5,13,I%,Normal%,Normal%,3,0,0)
  228.     CALL Title(1,0,"[Frame"+STR$(I%)+"]")
  229.   NEXT I%
  230.   FOR I%=4 TO 0 STEP -1                     'Window #8-12
  231.     CALL OpenWin(11,8+(I%*14),5,13,I%+4,Attr%(14,4),Attr%(14,4),3,0,0)
  232.     CALL Title(1,0,"[Frame"+STR$(I%+4)+"]")
  233.   NEXT I%
  234.   FOR I%=2 TO 0 STEP -1                     'Window #13-16
  235.     CALL OpenWin(14,19+(I%*17),5,14,I%+9,Attr%(15,5),Attr%(15,5),3,0,0)
  236.     CALL Title(2,0,"[Frame"+STR$(I%+9)+"]")
  237.   NEXT I%
  238.   FOR I%=1 TO 0 STEP -1                     'Window #17-18
  239.     CALL OpenWin(17,28+(I%*17),5,14,I%+12,Attr%(8,7),Attr%(8,7),3,0,0)
  240.     CALL Title(2,0,"[Frame"+STR$(I%+12)+"]")
  241.   NEXT I%
  242.   I$=GetKey$
  243.   FOR I%=0 TO 14
  244.     CALL CloseWin
  245.   NEXT I%
  246.   GOTO MainMenu
  247.  
  248. SayBye:
  249.   CALL OpenWin(1,1,25,80,0,7,7,0,1,0)       'Window #3
  250.   LOCATE 1,1
  251.   PRINT "Thanks for giving PBTools:Lite v1.2 a try!"
  252.   END
  253.  
  254. Other:
  255. X%=Xpos%(2)+2:Y%=Ypos%(2)+9
  256. CALL OpenWin(Y%,X%,6,20,2,30,31,3,1,1)        'Window #3
  257. IF CurDisplay%=0 THEN Hilite%=Attr%(0,7) ELSE Hilite%=Attr%(1,7)
  258. XWin%=1:YWin%=2
  259.  
  260. MainMenu2:
  261.   Choic%=Menu%(Menu2$(),1,4,Choic%,Hilite%,Attr%(14,1))
  262.   IF Choic%<1 THEN Choic%=4:GOTO MainMenu2
  263.   IF Choic%=1 THEN KeyStats
  264.   IF Choic%=2 THEN StringTools
  265.   IF Choic%=3 THEN StringTests
  266.   IF Choic%=4 THEN CALL CloseWin:GOTO MainMenu
  267.   GOTO MainMenu2
  268.  
  269. KeyStats:
  270.   CALL OpenWin(20,18,4,50,2,30,31,3,0,0)    'Window #4
  271.   CALL WPrintC(1,"Test or toggle the state of any key!",0)
  272.   CALL WPrintC(2,"Press ESC to end key demo.",0)
  273.   CALL OpenWin(7,28,12,28,2,30,31,3,0,0)    'Window #5
  274.   CALL WPrint(1,1,"  Toggle Keys      State  ",Attr%(15,4))
  275.   CALL WPrint(2,4,"Caps Lock",Attr%(14,1))
  276.   CALL WPrint(3,4,"Insert Key",Attr%(14,1))
  277.   CALL WPrint(4,4,"Num Lock",Attr%(14,1))
  278.   CALL WPrint(5,4,"Scroll Lock",Attr%(14,1))
  279.   CALL WPrint(6,1,"  Alternate Keys          ",Attr%(15,4))
  280.   CALL WPrint(7,4,"Alt Key",Attr%(14,1))
  281.   CALL WPrint(8,4,"Ctrl Key",Attr%(14,1))
  282.   CALL WPrint(9,4,"Left Shift",Attr%(14,1))
  283.   CALL WPrint(10,4,"Right Shift",Attr%(14,1))
  284.   'Set default toggle status
  285.   Caps%=CapStat%
  286.   Ins%=InsStat%
  287.   Num%=NumStat%
  288.   Scroll%=ScrollStat%
  289.   CALL CapsOff
  290.   CALL InsertOff
  291.   CALL NumOff
  292.   CALL ScrollOff
  293.   Alt$=False$
  294.   Ctrl$=False$
  295.   LShift$=False$
  296.   RShift$=False$
  297.   DO
  298.    IF CapStat% THEN Caps$=True$ ELSE Caps$=False$
  299.    IF InsStat% THEN Ins$=True$ ELSE Ins$=False$
  300.    IF NumStat% THEN Num$=True$ ELSE Num$=False$
  301.    IF ScrollStat% THEN Scroll$=True$ ELSE Scroll$=False$
  302.    IF IsAlt% THEN Alt$=True$ ELSE Alt$=False$
  303.    IF IsCtrl% THEN Ctrl$=True$ ELSE Ctrl$=False$
  304.    IF IsLShift% THEN LShift$=True$ ELSE LShift$=False$
  305.    IF IsRShift% THEN RShift$=True$ ELSE RShift$=False$
  306.    CALL WPrint(2,21,Caps$,Attr%(15,1))
  307.    CALL WPrint(3,21,Ins$,Attr%(15,1))
  308.    CALL WPrint(4,21,Num$,Attr%(15,1))
  309.    CALL WPrint(5,21,Scroll$,Attr%(15,1))
  310.    CALL WPrint(7,21,Alt$,Attr%(15,1))
  311.    CALL WPrint(8,21,Ctrl$,Attr%(15,1))
  312.    CALL WPrint(9,21,LShift$,Attr%(15,1))
  313.    CALL WPrint(10,21,RShift$,Attr%(15,1))
  314.   LOOP UNTIL INKEY$=CHR$(27)
  315.   'Restore all defaults for toggles
  316.   IF Caps% THEN CALL CapsOn
  317.   IF Ins% THEN CALL InsertOn
  318.   IF Num% THEN CALL NumOn
  319.   IF Scroll% THEN CALL ScrollOn
  320.   CALL CloseWin
  321.   CALL CloseWin
  322.   GOTO MainMenu2
  323.  
  324. StringTools:
  325.   N$=""
  326.   P$=""
  327.   CALL OpenWin(20,18,4,50,2,30,31,3,0,0)    'Window #4
  328.   CALL WPrintC(1,"You can do so much with our string tools!",0)
  329.   CALL WPrintC(2,"Press ESC to end key demo.",0)
  330.   CALL OpenWin(8,28,11,50,2,30,31,3,0,0)    'Window #5
  331.   CALL WPrintC(2,"Enter your name:",0)
  332.   CALL Box(11,42,3,22,1,0,Attr%(15,1),Attr%(14,4))
  333.   CALL TextIn(12,43,20,Attr%(15,4),Attr%(14,4),N$,Term$)
  334.   IF Term$=CHR$(27) THEN EndST
  335.   CALL WPrintC(6,"Enter your phone number:",0)
  336.   CALL Box(15,45,3,16,1,0,Attr%(15,1),Attr%(14,4))
  337.   CALL MaskIn(16,46,Attr%(15,4),Attr%(14,4),"(###)###-####",P$,Term$)
  338.   IF Term$=CHR$(7) THEN EndST
  339.   N$=N$+"  "+P$
  340.   DELAY 1
  341.   CALL NoShadow
  342.   CALL ClearWin
  343.   FOR X%=1 TO 5
  344.    CALL ChangeWin(4)
  345.    DELAY .25
  346.   NEXT X%
  347.   CALL AddShadow(3)
  348.   CurWin%=4
  349.   CALL WPrintC(1,"     Manipulating strings is a snap!     ",0)
  350.   CurWin%=5
  351.   CALL WPrintC(1,"Padding the string with characters is a breeze!",0)
  352.   CALL Box(10,29,3,48,1,0,Attr%(15,1),Attr%(14,1))
  353.   FOR X%=1 TO (46-LEN(N$))/2
  354.     N$=LPad$(N$,LEN(N$)+1,32)
  355.     CALL WPrint(3,2,N$,Attr%(14,4))
  356.     DELAY .5
  357.   NEXT X%
  358.   FOR X%=1 TO (46-LEN(N$))
  359.     N$=RPad$(N$,LEN(N$)+1,32)
  360.     CALL WPrint(3,2,N$,Attr%(14,4))
  361.     DELAY .5
  362.   NEXT X%
  363.   CALL WPrintC(3,REPEAT$(46," "),0)
  364.   N$=Trim$(N$)
  365.   CALL WPrintC(3,N$,Attr%(14,4))
  366.   N1$=N$
  367.   I$=GetKey$
  368.   EndST:
  369.   CALL CloseWin
  370.   CALL CloseWin
  371.   GOTO MainMenu2
  372.  
  373. StringTests:
  374.   CALL OpenWin(20,18,4,50,2,30,31,3,0,0)    'Window #4
  375.   CALL WPrintC(1,"Press any key on the keyboard.",0)
  376.   CALL WPrintC(2,"Press ESC to end key demo.",0)
  377.   CALL OpenWin(8,28,9,44,2,30,31,3,0,0)     'Window #5
  378.   CALL WPrintC(1,"Your Input:",Attr%(14,1))
  379.   CALL WPrint(3,2,"Input Character Type:",Attr%(14,1))
  380.   CALL WPrint(4,2,"  ASCII       :         Numeric    :",Attr%(14,1))
  381.   CALL WPrint(5,2,"  Alpha       :         Punctuation:",Attr%(14,1))
  382.   CALL WPrint(6,2,"  Alphanumeric:         Other      :",Attr%(14,1))
  383.   DO
  384.     I$=GetKey$
  385.     Oth$=Yes$
  386.     IF IsASCII%(I$) THEN ASII$=Yes$:Oth$=No$ ELSE ASII$=No$
  387.     IF IsAlpha%(I$) THEN Alpha$=Yes$:Oth$=No$ ELSE Alpha$=No$
  388.     IF IsAlphaNum%(I$) THEN AlphaNum$=Yes$:Oth$=No$ ELSE AlphaNum$=No$
  389.     IF IsNum%(I$) THEN Num$=Yes$:Oth$=No$ ELSE Num$=No$
  390.     IF IsPunct%(I$) THEN Punct$=Yes$:Oth$=No$ ELSE Punct$=No$
  391.     CALL WPrint(4,18,ASII$,Attr%(15,1))
  392.     CALL WPrint(5,18,Alpha$,Attr%(15,1))
  393.     CALL WPrint(6,18,AlphaNum$,Attr%(15,1))
  394.     CALL WPrint(4,39,Num$,Attr%(15,1))
  395.     CALL WPrint(5,39,Punct$,Attr%(15,1))
  396.     CALL WPrint(6,39,Oth$,Attr%(15,1))
  397.     If Oth$<>Yes$ THEN
  398.       CALL WPrint(1,28,I$+"    ",Attr%(15,1))
  399.     ELSE
  400.       CALL WPrint(1,28,"Other",Attr%(15,1))
  401.     END IF
  402.   LOOP UNTIL I$=CHR$(27)
  403.   CALL CloseWin
  404.   CALL CloseWin
  405.   GOTO MainMenu2
  406.